Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr52/rntx.zip/REINDEX.PRG

Text File | 1993-04-01 | 20KB | 657 lines

***********
*
*   Program....:  REINDEX.PRG
*   Author.....:  Reggie Moseley
*   Date.......:  02/02/90
*   Purpose....:  Creates/Rebuilds NTX indexes for DBF files by reading
*                 filenames and key expressions from an ASCII file.
*   Usage.....:   REINDEX [infile.[ext]] [alt_delm]
*   Link......:   LINK reindex,,nul,clipper+extend /SE:512 /NOE
*                 PLINK86 fi reindex lib clipper, extend
*   Parameters:   infile.ext - name of ASCII file containing the file and
*                 index key data. The format for each line of data is:
*
*                       dbfname # ntxname # key_expression
*
*                 Where '#' is the delimiter character separating the values,
*                 'dbfname' is the name of the DBF, 'ntxname' is the name of
*                 the NTX file, and 'key_expression' is a valid Clipper
*                 index expression, which may contain Clipper and Extend.LIB
*                 functions. If 'infile' is not passed, the program searches
*                 for REINDEX.KEY to use as the default input file. If infile
*                 is passed without an extension (.ext), the default is KEY.
*                 An '*' can be used to comment out lines in the input file.
*
*                 alt_delm - character to use as a delimiter instead of '#'.
*                 It must be one character in length and may not be an alpha-
*                 betic, nor numeric, nor low ASCII (hex code less than 20),
*                 nor high ASCII (hex code greater than 7F).To assign a space
*                 as the delimiter, pass an '*' (asterik may not be assigned
*                 as a delimiter). The delimiter may be reassigned in the
*                 input text file by inserting the following comment line:
*
*                       * delimiter alt_delm
*
*                 The new delimiter remains in effect until it is changed by
*                 another delimiter comment. The aforementioned rules for
*                 delimiter assignment apply to 'alt_delm' in the delimiter
*                 comment. If the comment appears without an alt_delm, the
*                 delimiter will revert back to the original '#' character.
*
   parameters textname, new_delm

   private size, buffer, thandle, more_text, temp_bufr, more_chrs, delm_code
   public inputname, inputfile

   if type( "textname" ) = "U"           && no parms passed?
      inputname = "REINDEX.KEY"          && use default input
   else
      inputname = textname
   endif

   if "?" $ inputname                    && ? means display help
      usage_help()
   endif

   inputfile = val_fname( inputname, "KEY" )
   inputname = val_fname( inputname )

   if !file( inputfile )                 && no input file found?
      if inputfile $ "REINDEX.KEY"       && if no parms passed, display help
         usage_help()
      else                               && else display an error message
         ? "File " + inputfile + " not found in current directory"
         ? "DOS Errorlevel: 2"
         errorlevel( 2 )                 && for use within batch files
         quit
      endif
   endif

   public delm
   delm = if( type( "new_delm" ) == "C", val_delim( new_delm ), "#" )

   binit( 1, 2048 )                      && initialize 2K buffer

   thandle = bopen( inputfile, 0 )       && open text file read only

   if ferror() != 0                      && text file not opened
      ? "Open error on file " + inputfile
      ? "DOS Errorlevel: 1"
      errorlevel( 1 )
      quit
   endif

   size   = 80
   buffer = space( size )                && init buffer to max line size

   ? "REINDEX - Clipper Reindexing Utility, Version 1.0"
   ? "Written by Reggie Moseley, Regmo Systems, Copyright (c) 1990."
   ?

   select 0
   more_text = bread( thandle, @buffer, size )       && prime the buffer

   do while more_text != 0
      more_chrs = scanlines( @buffer )   && do each line in buffer
      if more_chrs = 0
         more_text = bread( thandle, @buffer, size ) && refill the buffer
      else
         temp_bufr = buffer
         more_text = bread( thandle, @buffer, size ) && append chars to
         buffer = temp_bufr + buffer                 && current buffer
      endif
   enddo

   ?
   ? "All files declared in " + inputfile + ;
     " have been successfully reindexed"
   ?

   bclose( thandle )                     && close text file

   bend()                                && terminate buffer system

   errorlevel( 0 )                       && let batch file know we're OK

quit


external strtran, alltrim, left, rat, right, descend, examplep



***
* val_delim
***

function val_delim
   parameters _char

   _char = ltrim( trim( _char ) )        && trim it in case parseline() didn't

   if _char == "*"                       && asterik passed; delim = space
      retu space( 1 )
   endif

   if "" = _char                         && null passed; delim = number sign
      retu "#"
   endif

   private _delm_ok, _delm_msg
   _delm_ok  = .F.
   _delm_msg = ""

   do case
   case len( _char ) > 1                 && only one alternate delim allowed
      _delm_msg = "Must not exceed one character in length"
   case asc( _char ) < 32 .OR. asc( _char ) > 127 && no special ASCII codes!
      _delm_msg = "Must not have a low (< 32) or high (> 127) ASCII value"
   case isalpha( _char )                 && no letters allowed!
      _delm_msg = "Must not be an alphabetic character"
   case _char == "0" .OR. val( _char ) > 0  && no numbers, either!
      _delm_msg = "Must not be a numeric character"
   otherwise
      _delm_ok = .T.                     && this char will do just fine!
   endcase

   if !_delm_ok                          && bad delim char
      ? "Invalid alternate delimiter " + _char
      ? _delm_msg
      ? "DOS Errorlevel: 1"
      errorlevel( 1 )
      quit
   endif

return _char



***
* scanlines
***

function scanlines
   parameters bufr_str

   private chrs_left, lf_pos, text_line, linefeed, crlf, detail, alt_delm, ;
           dbfname, ntxname, ntx_key, _pos

   linefeed  = chr( 10 )
   crlf      = chr( 13 ) + chr( 10 )
   chrs_left = len( bufr_str )

   do while chrs_left != 0

      lf_pos = at( linefeed, bufr_str )  && line feed is end of ASCII line

      if lf_pos > 0                      && line feed found?
         text_line = substr( bufr_str, 1, lf_pos )   && copy text from buffer
         detail = strtran( text_line, crlf, "" )     && strip off CR/LF pair
         dbfname = parseline( @detail, delm )        && break off 1st token

         do case             && check for dbfname, comment, or blank line
         case "" = dbfname
            *** blank line - skip it and keep pushin'! ***
         case "*" = substr( dbfname, 1, 1 )   && comment line found?
            *** comment line - if delimiter change, validate it! ***
            _pos = at( "DELIMITER", upper( dbfname ) )
            if _pos > 0
               alt_delm = ltrim( trim( substr( dbfname, _pos + 9 ) ) )
               delm = val_delim( alt_delm )
            endif
         otherwise
            *** data line - cut it up and process the data! ***
            ntxname = parseline( @detail, delm )  && 2nd token is ntxname
            ntx_key = parseline( @detail, delm )  && 3rd token is ntx_key
            do_index( dbfname, ntxname, ntx_key ) && do the index thing!
         endcase

         chrs_left = chrs_left - lf_pos  && deduct the chars done
         bufr_str  = substr( bufr_str, lf_pos + 1, chrs_left ) && adj buffer
      else
         exit                            && else, we need more bananas (text)
      endif

   enddo

return chrs_left


***
* parseline
***

function parseline
   parameter _line, _delm

   private delm_pos, piece

   delm_pos = at( _delm, _line )         && position of the next delimiter
   piece = if( delm_pos > 0, substr( _line, 1, delm_pos - 1 ), _line )
   _line = if( delm_pos > 0, substr( _line, delm_pos + 1 ), "" )
   _line = ltrim( trim( _line ) )

return ltrim( trim( piece ) )


***
* do_index
***

function do_index
   parameters _dbfname, _ntxname, _ntx_key

   private msg_hdg

   _dbffile = val_fname( _dbfname, "DBF" )
   _dbfname = val_fname( _dbfname )

   if !file( _dbffile )
      ? _dbffile + " not found in current directory"
      ? "DOS Errorlevel: 2"
      errorlevel( 2 )
      quit
   endif

   if !net_use( _dbfname, .T., 5 )       && open DBF for exclusive use
      ? _dbffile + " unavailable for reindexing - in use by other user(s)"
      ? "DOS Errorlevel: 32"
      errorlevel( 32 )
      quit
   endif

   _ntxfile = val_fname( _ntxname, "NTX" )
   _ntxname = val_fname( _ntxname )

   if file( _ntxfile )
      copy file &_ntxfile to &_ntxname..NBK
      delete file &_ntxfile
      msg_hdg = "Replacing old index "
   else
      msg_hdg = "Creating new index "
   endif

   _ntx_key = upper( ltrim( trim ( _ntx_key ) ) )
   _test = type( "&_ntx_key" )           && test for valid key expression

   if _test  $ "CDN" .OR. _test == "UI"  && UI means an Extend.LIB func used
      show_msg = msg_hdg + _ntxname + " for file " + _dbfname + "..."
      ? show_msg
      index on &_ntx_key to &_ntxname
      use
   else
      ? "Index expression for " + _dbffile + " invalid: " + _ntx_key
   endif

return .T.


***
* val_fname
***

function val_fname
   parameter _spec, _ext

   private period_pos, full_spec, result

   _spec = upper( ltrim( trim( _spec ) ) )
   full_spec = if( type( "_ext" ) == "C", .T., .F. )
   period_pos = at( ".", _spec )

   if full_spec                          && .T. if fname+extension desired
      result = if( period_pos > 0, _spec, _spec + "." + _ext )
   else                                  && .F. if fname only desired
      result = if( period_pos > 0, substr( _spec, 1, period_pos - 1 ), _spec )
   endif

return result


***
* net_use - from Nantucket Corp.
***

function net_use
   parameters file, ex_use, wait

   private forever

   forever = ( wait = 0 )
   do while ( forever .OR. wait > 0 )
      if ex_use                          && exclusive
         use &file exclusive
      else
         use &file                       && shared
      endif

      if .not. neterr()                  && use succeeds
         retu .T.
      endif

      inkey( 1 )                         && wait 1 second
      wait = wait - 1
   enddo

return .F.                               && use fails


***
* usage_help
***

function usage_help

   clear screen
   ? "REINDEX - Clipper File Reindexing Utility, (c) 1990 Regmo Systems"
   ? "Purpose: Create/Replace Clipper indexes via an index control file"
   ? "Syntax : REINDEX [inputname[.ext]] [delim]"
   ? "Where  : 'inputname' - name of text file containing the index data,"
   ? "                       defaults to 'REINDEX.KEY' in current directory"
   ? "         '.ext'      - file extension; defaults to '.key'"
   ? "         'delim'     - inline data delimiter; defaults to '#'"
   ? "Sample Calls : reindex  or  reindex myfiles  or  reindex herdata.txt"
   ? "Conventions  : Assumes 'inputname' is in current directory"
   ?
   ? "Inputname must be an ASCII text file, with a linefeed (hex 0A)"
   ? "terminating each line of data, and an end-of-file (hex 1A) marker"
   ? "as the last character. Each line of text must contain the following:"
   ?
   ? "         dbfname # ntxname # key_expression"
   ?
   ? "The number sign '#' is used to separate the data within each line."
   ? "'dbfname' is the name of the DBF file to be indexed, 'ntxname' is"
   ? "the name assigned to the index file, and 'key_expression' is any"
   ? "valid Clipper index expression (Clipper functions and Extend.LIB"
   ? "functions may be used). Lines beginning with an asterik '*' are"
   ? "considered comments and are not processed; blank lines are ignored."
   ?

   ? "Press any key for more help..."
   inkey( 0 )

   ? "Delim must be a single character, with an ASCII value greater than 31"
   ? "(hex 1F) and less than 128 (hex 80). Alphabetics, numerics, and the"
   ? "asterik cannot be used. The delimiter can be changed within the input"
   ? "file by including it in a special comment line: '* DELIMITER delim'"
   ? "This comment may appear multiple times in the text and the delimiter"
   ? "will remain in effect until the next occurance. To assign a space as"
   ? "the delimiter, set delim to '*'. If delim is left blank, the original"
   ? "number sign delimiter '#' is restored. Here's a typical input file: "
   ?
   ? "* This is a comment; assume these lines are in myfiles.key"
   ? "my1stfil # my1st1 # fld1"
   ? "my1stfil # my1st2 # str( fld2, 2) + dtoc( datefld )"
   ? "* Change delimiter to '/' and use Extend.LIB functions in key:"
   ? "* delimiter /"
   ? "my2ndfil / my2nd1 / transform( numfld, '###' ) + strzero( othr_num )"
   ? "* Lines are not case-sensitive; and blank lines are ignored..."
   ?
   ? "* Change delimiter to a space and remove spaces in long expressions:"
   ? "* DELIMITER *"
   ? "my2ndfil my2nd2 substr(dtoc(inpdate),7,2)+str(invoice_no)"
   ? "* Change delimiter back to '#'"
   ? "* delimiter"
   ? "my3rdfil#my3rdndx#last_name + frst_name"
   ?

   quit

return .T.


***
*
* Buffered I/O for Clipper low-level file functions
*
*
* First call BINIT with number of files to buffer, and size of each
* buffer. Call BEND when finished to relase memory. BOPEN opens a
* a file in buffered mode, BCLOSE closes it. BREAD reads from it.
* BWRITE writes to it. Adapted from original code by Rick Spence.
***

***
* binit( num_handles, buffer_size )
*
* Initialize buffering system, return .T. for succcess, .F. for failure
*

function binit

   parameters num_handles, buffer_size

   public buffers[ num_handles ]
   public buff_size
   public next_char[ num_handles ]
   public num_in_buff[ num_handles ]
   public more_to_read[ num_handles ]
   public handles[ num_handles ]

   buff_size = buffer_size
   afill( handles, 0 )

return .T.


***
*   beof( handle )
*
*   Return end of file status for this file
*

function beof

   parameters handle
   private buff_no

   buff_no = ascan( handles, handle )

return !more_to_read[ buff_no ] .and. ;
       next_char[ buff_no ] = num_in_buff[ buff_no ] + 1


***
* bend()
*
* Terminate the buffering system.
*

function bend

   release buffers
   release buff_size
   release next_char
   release num_in_buff
   release more_to_read
   release handles

return .T.


***
* bopen( file_spec, open_mode )
*
* Open file_spec with open_mode. Return file handle. -1 if error.
*

function bopen

   parameters file_spec, open_mode
   private handle, buff_no

   handle = fopen( file_spec, open_mode )

   if handle != ( -1 )
      * allocate a buffer number for it ...
      buff_no = ascan( handles, 0 )
      if buff_no != 0
         * set up structure
         handles[ buff_no ] = handle
         buffers[ buff_no ] = space( buff_size )
         next_char[ buff_no ] = 1
         num_in_buff[ buff_no ] = 0
         more_to_read[ buff_no ] = .T.
      else
         * no room for buffer, so close file and return -1
         fclose( handle )
         handle = -1
      endif
   endif

return handle


***
* bclose( handle )
*
* Close handle.
*

function bclose

   parameter handle
   private buff_no

   buff_no = ascan( handles, handle )

   buffers[ buff_no ] = ""
   handles[ buff_no ] = 0
   fclose( handle )

return .T.


***
* bcreate( file_spec, open_mode )
*
* Create file_spec with open_mode. Return file handle. -1 if error.
*

function bcreate

   parameters file_spec, open_mode
   private handle, buff_no

   handle = fcreate( file_spec, open_mode )

   if handle != ( -1 )
      * allocate a buffer number for it ...
      buff_no = ascan( handles, 0 )
      if buff_no != 0
         * set up structure
         handles[ buff_no ] = handle
         buffers[ buff_no ] = space( buff_size )
         next_char[ buff_no ] = 1
         num_in_buff[ buff_no ] = 0
         more_to_read[ buff_no ] = .T.
      else
         * no room for buffer, so close file and return -1
         fclose( handle )
         handle = -1
      endif
   endif

return handle


***
* bread( handle, buffer, size )
*
* Buffered read from handle for size bytes.  Buffer must be passed by
* reference.  Returns number of bytes read.
*

function bread

   parameters handle, buffer, size
   private remain, tbuffer, buff_no

   buff_no = ascan( handles, handle )
   tbuffer = space( buff_size )

   * can the entire read be satisfied from the buffer ??
   remain = num_in_buff[ buff_no ] - next_char[ buff_no ] + 1

   if remain >= size
      * yes it can, so simply return it
      buffer = substr( buffers[ buff_no ], next_char[ buff_no ], size )
      next_char[ buff_no ] = next_char[ buff_no ] + size

   else
      * no it can't, so get what is required from this buffer then
      * refill repeatedly until bread is satisfied
      if remain > 0
         buffer = substr( buffers[ buff_no ], next_char[ buff_no ], remain )
         size = size - remain
         next_char[ buff_no ] = next_char[ buff_no ] + remain
      else
         buffer = ""
      endif

      do while size > 0 .and. more_to_read[ buff_no ]
         * refill buffer, or best we can ...
         num_in_buff[ buff_no ] = fread( handle, @tbuffer, buff_size )
         buffers[ buff_no ] = tbuffer
         more_to_read[buff_no] = if(num_in_buff[buff_no] = buff_size,.T.,.F.)

         * can it now be satisfied from buffer ??
         if size <= num_in_buff[ buff_no ]
            * yes, so finish off ...
            buffer = buffer + substr( buffers[ buff_no ], 1, size )
            next_char[ buff_no ] = size + 1
            size = 0
         else
            buffer = buffer + substr( buffers[ buff_no ], 1, ;
            num_in_buff[ buff_no ] )
            next_char[ buff_no ] = num_in_buff[ buff_no ] + 1
            size = size - num_in_buff[ buff_no ]
         endif
      enddo
   endif

return len( buffer )


***
* bwrite( handle, buffer, size )
*
* Write to handle from buffer for size no. of bytes,
* returns no. of bytes written.
*
* NOTE: This function is for compatability within the buffered I/O
*       function set. No special processing is performed and all parms
*       are passed to FWRITE(), which returns the no. of bytes written.
*

function bwrite

   parameters handle, buffer, size

   size = if( type( "size" ) = "n", size, len( buffer ) )

return fwrite( handle, buffer, size )


***
* btell( handle )
*
* Returns the current file position within handle.
*
* NOTE: This function is for compatability within the buffered I/O
*       function set. No special processing is performed and all parms are
*       passed to FSEEK(), which returns the current position in the file.
*

function btell

   parameters handle

return fseek( handle, 0, 1 )


* EOF: REINDEX.PRG